home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8406.arc / GETSTRNG.BAS < prev    next >
BASIC Source File  |  1986-09-14  |  2KB  |  38 lines
  1. 1000  'Test program for Get String subroutine
  2. 1001  '
  3. 1020  SCREEN 0:WIDTH 40:CLS
  4. 1040  LMAX%=10:FX%=15:FY%=10:OLD$="foo":GOSUB 6200
  5. 1050  CLS:IF ESCAPE=1 THEN PRINT">>Text entry aborted...":END
  6. 1060  PRINT">>Text entered was: ";X$:END
  7. 1998  '
  8. 1999  '
  9. 6200  '>>>>>Subroutine: Get String
  10. 6201  '
  11. 6210  K%=0:X$="":Z$=""                              'Init variables
  12. 6215  IF LEN(OLD$)>LMAX% THEN OLD$=LEFT$(OLD$,LMAX%)'Truncate old text
  13. 6220  X$=OLD$:C%=LEN(X$)+1:QX%=FX%+C%               'Set length counter
  14. 6225  LOCATE FY%,FX%,0:PRINT"|";OLD$;STRING$(LMAX%-LEN(OLD$),46);"|";
  15. 6230  LOCATE FY%,QX%:PRINT"_";
  16. 6235  WHILE (K%<>13) AND (K%<>27)            'While not (ESC) or (CR)
  17. 6238    Z$="":WHILE LEN(Z$)=0:Z$=INKEY$:WEND 'Wait for character
  18. 6240    K%=ASC(Z$)                           'Get ASCII code equivalent
  19. 6242    IF K%<>24 THEN 6250                  'CANcel handler follows:
  20. 6245    X$="":C%=1:LOCATE FY%,FX%+1:PRINT STRING$(LMAX%,46)
  21. 6247    LOCATE FY%,FX%+1,1:PRINT"_";:GOTO 6280
  22. 6250    IF K%<>8 THEN 6260                   'Backspace handler follows:
  23. 6252    IF C%=1 THEN SOUND 50,4:GOTO 6280    'If field is empty, honk
  24. 6254    IF C%<=LMAX% THEN LOCATE FY%,FX%+C%:PRINT".";
  25. 6255    C%=C%-1:LOCATE FY%,FX%+C%:PRINT"_";:LOCATE FY%,FX%+C%
  26. 6257    IF C%=1 THEN X$="": ELSE X$=LEFT$(X$,C%-1)
  27. 6258    GOTO 6280
  28. 6260    IF (K%=13) OR (K%=27) THEN 6280            '(ESC) or (CR)
  29. 6265    IF (K%<32) OR (K%>126) THEN SOUND 50,4:GOTO 6280 'Printable?
  30. 6270    IF C%>LMAX% THEN SOUND 50,4:GOTO 6280      'String is at max size
  31. 6272    LOCATE FY%,FX%+C%:PRINT Z$;:C%=C%+1        'Display new char.
  32. 6275    IF C%<=LMAX% THEN LOCATE FY%,FX%+C%:PRINT"_";
  33. 6278    X$=X$+Z$                              'Append new character to X$
  34. 6280  WEND
  35. 6285  IF K%=27 THEN ESCAPE=1:ELSE ESCAPE=0    'Set escape flag if apropos
  36. 6290  RETURN
  37. 6299  '
  38.